#lang racket

(define (=number? exp num)
  (and (number? exp) (= exp num)))

(define (variable? x) (symbol? x))

(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))

;HELP-------------------------------------------------------------------------------------------------------
(define (acc op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (acc op initial (cdr sequence)))))

(define (copy-while f xs)
  (cond ((null? xs) '())
        ((f (car xs)) (cons (car xs) (copy-while f (cdr xs))))
        (else '())))

(define (delete-while f xs)
  (cond ((null? xs) '())
        ((not (f (car xs))) xs)
        (else (delete-while f (cdr xs)))))

(define (delete-while+ f xs) (cdr (delete-while f xs)))

(define operators (list '+ '*))

(define (contains x y)
  (cond ((null? x) false)
        ((eq? (car x) y) true)
        (else (contains (cdr x) y))))

(define (properly-ordered? x)
  (cond ((null? x) false)
        ((and (null? (cdr x)) (not (contains operators (car x)))) true)
        ((and (not (contains operators (car x))) (contains operators (cadr x)))
         (properly-ordered? (cddr x)))
        (else false)))

(define (proper-expr? x)
  (cond ((number? x) true)
        ((variable? x) true)
        ((and (pair? x) (properly-ordered? x))
         (acc (lambda (y z) (and y z)) true 
              (map (lambda (y) (proper-expr? y))
                   (filter (lambda (y) (not (contains operators y))) x))))
        (else false)))
;TODO-------------------------------------------------------------------------------------------------------
(define (sum? x)
  (and (pair? x) (proper-expr? x) (contains x '+)))

(define (product? x)
  (and (pair? x) (proper-expr? x) (not (contains x '+))))

(define (addend s)
  (let ((add1 (copy-while (lambda (x) (not (eq? x '+))) s)))
    (if (null? (cdr add1))
        (car add1)
        add1)))
;(car s)

(define (augend s)
  (let ((add2 (delete-while+ (lambda (x) (not (eq? x '+))) s)))
    (if (null? (cdr add2))
        (car add2)
        add2)))
;(caddr s)

(define (multiplier p)
  (let ((mul1 (copy-while (lambda (x) (not (eq? x '*))) p)))
    (if (null? (cdr mul1))
        (car mul1)
        mul1)))
;(car p)

(define (multiplicand p)
  (let ((mul2 (delete-while+ (lambda (x) (not (eq? x '*))) p)))
    (if (null? (cdr mul2))
        (car mul2)
        mul2)))
;(caddr p)

(define (make-sum a1 a2)
  (list a1 '+ a2))
;(cond ((=number? a1 0) a2)
;        ((=number? a2 0) a1)
;        ((and (number? a1) (number? a2)) (+ a1 a2))
;        (else (list a1 '+ a2)))

(define (make-product m1 m2)
  (let ((right (cond ((not (pair? m2)) (list '* m2))
                     ((sum? m2) (list '* m2))
                     ((pair? m2) (cons '* m2)))))
    (let ((whole (cond ((not (pair? m1)) (cons m1 right))
                       ((sum? m1) (cons m1 right))
                       ((pair? m1) (append m1 right)))))
      whole)))
;(cond ((or (=number? m1 0) (=number? m2 0)) 0)
;        ((=number? m1 1) m2)
;        ((=number? m2 1) m1)
;        ((and (number? m1) (number? m2)) (* m1 m2))
;        (else (list m1 '* m2)))

;------------------------------------------------------------------------------------------------------------

(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((sum? exp)
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var)))
        ((product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv (multiplicand exp) var))
          (make-product (deriv (multiplier exp) var)
                        (multiplicand exp))))
        (else
         (error "unknown expression"))))

;TEST--------------------------------------------------------------------------------------------------------
;(proper-expr? '(3 + 4 * (5 + 6)))
;(sum? '(3 * 5 * (6 + 7)))
;(copy-while (lambda (x) (not (eq? x '+))) '((1 * 3) + 4 + 5))

;(delete-while+ (lambda (x) (not (eq? x '+))) '((1 * 3) + 4 + 5))

(addend '(2 + 3 * (4 * 1) + 5))

(augend '(3 * (4 * 1) + 5))

(multiplier '(2 * 3 * (4 * 1) * 5))

(multiplicand '(3 * (4 * 1) * 5))

(make-product '(3 * y) 'x)

(deriv '(x + x * (x + y + 2)) 'x)